home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / serial / serializ.bas < prev    next >
Encoding:
BASIC Source File  |  1995-03-06  |  5.7 KB  |  208 lines
  1. Option Explicit
  2.  
  3. Global Const ApplicationName = "SERIALIZ"
  4.  
  5. Global DirectoryForApplication      As String
  6. Global SelectedLanguage             As String
  7. Global CurrentLanguage              As Integer
  8. Global SaveTitleForm                As String
  9.  
  10. Global FileToUse                    As String
  11.  
  12. Global SERIALDATA                   As tagSERIALDATA
  13.  
  14. Sub FileProcessAdd ()
  15.  
  16.    Dim ErrCode          As Integer
  17.    Dim WasSerial        As Integer
  18.  
  19.    ' get the full name to use
  20.    FileToUse = GetFileToUse()
  21.  
  22.    ' if no file selected, stop
  23.    If (Len(FileToUse) = 0) Then Exit Sub
  24.  
  25.    ' check if file is serialized
  26.    WasSerial = cIsSerial(FileToUse)
  27.  
  28.    ' format the serial number field
  29.    frmSerialization.SerNumber.Text = Val(frmSerialization.SerNumber.Text)
  30.  
  31.    ' set the serialization info from fields
  32.    SERIALDATA.Description1 = frmSerialization.SerPart1.Text
  33.    SERIALDATA.Description2 = frmSerialization.SerPart2.Text
  34.    SERIALDATA.Number = frmSerialization.SerNumber.Text
  35.    ' put the serialization info
  36.    ErrCode = cSerialPut(FileToUse, SERIALDATA)
  37.  
  38.    ' check if file was been serialized
  39.    If (WasSerial = False) Then
  40.       ' yes, display the message
  41.       Call MessageDisplay("2", FileToUse)
  42.  
  43.    Else
  44.       ' no, display the message
  45.       Call MessageDisplay("3", FileToUse)
  46.  
  47.    End If
  48.  
  49. End Sub
  50.  
  51. Sub FileProcessChange ()
  52.  
  53.    Dim ErrCode          As Integer
  54.  
  55.    ' get the full name to use
  56.    FileToUse = GetFileToUse()
  57.  
  58.    ' if no file selected, stop
  59.    If (Len(FileToUse) = 0) Then Exit Sub
  60.  
  61.    ' check if file is serialized
  62.    If (cIsSerial(FileToUse) = 0) Then
  63.       ' no, display error
  64.       Call MessageDisplay("1", FileToUse)
  65.  
  66.    Else
  67.       ' yes, add 1 to serial number
  68.       ErrCode = cSerialInc(FileToUse, 1)
  69.       ' read the serialization info
  70.       ErrCode = cSerialGet(FileToUse, SERIALDATA)
  71.       ' set the serialization info on fields
  72.       frmSerialization.SerPart1.Text = SERIALDATA.Description1
  73.       frmSerialization.SerPart2.Text = SERIALDATA.Description2
  74.       frmSerialization.SerNumber.Text = SERIALDATA.Number
  75.       ' check the serial number, for example MOD 10
  76.       If ((SERIALDATA.Number Mod 10) = 0) Then
  77.          ' yes, modulo 10, display message
  78.          Call MessageDisplay("4", FileToUse)
  79.       End If
  80.  
  81.    End If
  82.  
  83. End Sub
  84.  
  85. Sub FileProcessRead ()
  86.  
  87.    Dim ErrCode          As Integer
  88.  
  89.    ' get the full name to use
  90.    FileToUse = GetFileToUse()
  91.  
  92.    ' if no file selected, stop
  93.    If (Len(FileToUse) = 0) Then Exit Sub
  94.  
  95.    ' check if file is serialized
  96.    If (cIsSerial(FileToUse) = 0) Then
  97.       ' no, display error
  98.       Call MessageDisplay("1", FileToUse)
  99.  
  100.    Else
  101.       ' yes, display the serialization info
  102.       ErrCode = cSerialGet(FileToUse, SERIALDATA)
  103.       ' set the serialization info on fields
  104.       frmSerialization.SerPart1.Text = SERIALDATA.Description1
  105.       frmSerialization.SerPart2.Text = SERIALDATA.Description2
  106.       frmSerialization.SerNumber.Text = SERIALDATA.Number
  107.  
  108.    End If
  109.  
  110. End Sub
  111.  
  112. Sub FileProcessRemove ()
  113.  
  114.    Dim ErrCode          As Integer
  115.  
  116.    ' get the full name to use
  117.    FileToUse = GetFileToUse()
  118.  
  119.    ' if no file selected, stop
  120.    If (Len(FileToUse) = 0) Then Exit Sub
  121.  
  122.    ' check if file is serialized
  123.    If (cIsSerial(FileToUse) = 0) Then
  124.       ' no, display error
  125.       Call MessageDisplay("1", FileToUse)
  126.  
  127.    Else
  128.       ' yes, remove the serialization info
  129.       ErrCode = cSerialRmv(FileToUse)
  130.       ' display remove message
  131.       Call MessageDisplay("5", FileToUse)
  132.  
  133.    End If
  134.  
  135. End Sub
  136.  
  137. Function GetFileToUse () As String
  138.  
  139.    ' check if a file has been selected
  140.    If (frmSerialization.File1.ListIndex >= 0) Then
  141.       ' yes, form the full name
  142.       GetFileToUse = frmSerialization.File1.Path + "\" + frmSerialization.File1.List(frmSerialization.File1.ListIndex)
  143.  
  144.    Else
  145.  
  146.       Call MessageDisplay("0", "")
  147.       
  148.       ' no, return empty
  149.       GetFileToUse = ""
  150.  
  151.    End If
  152.  
  153. End Function
  154.  
  155. Sub Loader ()
  156.  
  157.    DoEvents
  158.  
  159.    Dim ErrCode    As Integer
  160.    Dim SplitPath  As tagSPLITPATH
  161.  
  162.    ' some initializations
  163.    CurrentLanguage = LNG_ENGLISH
  164.    DirectoryForApplication = cGetIn(cEXEnameActiveWindow(), ".", 1)
  165.    ' split the path of the application into four components
  166.    ErrCode = cSplitPath(DirectoryForApplication, SplitPath)
  167.    ' regenerate only the directory of the application
  168.    DirectoryForApplication = SplitPath.nDrive + SplitPath.nDir
  169.    ' set the default language
  170.    SelectedLanguage = ".TUK"
  171.  
  172.    ' save the caption of this form
  173.    SaveTitleForm = frmSerialization.Caption
  174.    
  175.    ' change the language to the current language in the system menu of the current form
  176.    Call cLngSysMenu(CurrentLanguage, frmSerialization.hWnd)
  177.    
  178.    ErrCode = cReadCtlLanguage(frmSerialization.Label1(0), RS_CAPTION, DirectoryForApplication + ApplicationName + SelectedLanguage)
  179.  
  180. End Sub
  181.  
  182. Sub MessageDisplay (TextOrder As String, InsertText As String)
  183.  
  184.    ' display a multi-language message box, message are centered
  185.    ' and a timeout of 30 seconds is displayed.
  186.    Call cLngBoxMsg(CurrentLanguage, ReadText(TextOrder, InsertText), MB_MESSAGE_LEFT Or MB_TIMEOUT_30 Or MB_DISPLAY_TIMEOUT Or 32, SaveTitleForm)
  187.  
  188. End Sub
  189.  
  190. Function ReadText (TextOrder As String, InsertText As String) As String
  191.  
  192.    Dim Tmp              As String
  193.    Dim BasisText        As String
  194.  
  195.    ' read the text in the language file
  196.    BasisText = cGetIni(ApplicationName, TextOrder, "?", DirectoryForApplication & ApplicationName & SelectedLanguage)
  197.    
  198.    ' insert some text if any
  199.    Tmp = cInsertBlocks(BasisText, InsertText)
  200.  
  201.    ' change all º to make a CR
  202.    Call cChangeChars(Tmp, "º", Chr$(13))
  203.  
  204.    ReadText = Tmp
  205.  
  206. End Function
  207.  
  208.